home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Controls / Visual Basic Controls.iso / vbcontrol / axpicker / axpicker.ctl < prev    next >
Encoding:
Visual Basic user-defined control file  |  1999-05-09  |  15.0 KB  |  459 lines
  1. VERSION 5.00
  2. Begin VB.UserControl axPicker 
  3.    ClientHeight    =   2130
  4.    ClientLeft      =   0
  5.    ClientTop       =   0
  6.    ClientWidth     =   6000
  7.    ScaleHeight     =   142
  8.    ScaleMode       =   3  'Pixel
  9.    ScaleWidth      =   400
  10.    ToolboxBitmap   =   "axPicker.ctx":0000
  11.    Begin VB.Frame fraButtons 
  12.       Appearance      =   0  'Flat
  13.       BackColor       =   &H00C0C0C0&
  14.       BorderStyle     =   0  'None
  15.       ForeColor       =   &H80000008&
  16.       Height          =   1635
  17.       Left            =   2790
  18.       TabIndex        =   4
  19.       Top             =   360
  20.       Width           =   465
  21.       Begin axPicklistControl.axPickerButton axButton 
  22.          Height          =   405
  23.          Index           =   1
  24.          Left            =   0
  25.          TabIndex        =   5
  26.          Top             =   405
  27.          Width           =   450
  28.          _ExtentX        =   794
  29.          _ExtentY        =   714
  30.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  31.             Name            =   "MS Sans Serif"
  32.             Size            =   8.25
  33.             Charset         =   0
  34.             Weight          =   400
  35.             Underline       =   0   'False
  36.             Italic          =   0   'False
  37.             Strikethrough   =   0   'False
  38.          EndProperty
  39.          Picture         =   "axPicker.ctx":0312
  40.       End
  41.       Begin axPicklistControl.axPickerButton axButton 
  42.          Height          =   405
  43.          Index           =   2
  44.          Left            =   0
  45.          TabIndex        =   6
  46.          Top             =   810
  47.          Width           =   450
  48.          _ExtentX        =   794
  49.          _ExtentY        =   714
  50.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  51.             Name            =   "MS Sans Serif"
  52.             Size            =   8.25
  53.             Charset         =   0
  54.             Weight          =   400
  55.             Underline       =   0   'False
  56.             Italic          =   0   'False
  57.             Strikethrough   =   0   'False
  58.          EndProperty
  59.          Picture         =   "axPicker.ctx":0664
  60.       End
  61.       Begin axPicklistControl.axPickerButton axButton 
  62.          Height          =   405
  63.          Index           =   3
  64.          Left            =   0
  65.          TabIndex        =   7
  66.          Top             =   1215
  67.          Width           =   450
  68.          _ExtentX        =   794
  69.          _ExtentY        =   714
  70.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  71.             Name            =   "MS Sans Serif"
  72.             Size            =   8.25
  73.             Charset         =   0
  74.             Weight          =   400
  75.             Underline       =   0   'False
  76.             Italic          =   0   'False
  77.             Strikethrough   =   0   'False
  78.          EndProperty
  79.          Picture         =   "axPicker.ctx":09B6
  80.       End
  81.       Begin axPicklistControl.axPickerButton axButton 
  82.          Height          =   405
  83.          Index           =   0
  84.          Left            =   0
  85.          TabIndex        =   8
  86.          Top             =   0
  87.          Width           =   450
  88.          _ExtentX        =   794
  89.          _ExtentY        =   714
  90.          BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  91.             Name            =   "MS Sans Serif"
  92.             Size            =   8.25
  93.             Charset         =   0
  94.             Weight          =   400
  95.             Underline       =   0   'False
  96.             Italic          =   0   'False
  97.             Strikethrough   =   0   'False
  98.          EndProperty
  99.          Picture         =   "axPicker.ctx":0D08
  100.       End
  101.    End
  102.    Begin VB.ListBox lstAvailable 
  103.       DragIcon        =   "axPicker.ctx":105A
  104.       Height          =   1620
  105.       Left            =   135
  106.       MultiSelect     =   2  'Extended
  107.       TabIndex        =   1
  108.       Top             =   360
  109.       Width           =   2535
  110.    End
  111.    Begin VB.ListBox lstSelected 
  112.       DragIcon        =   "axPicker.ctx":1364
  113.       Height          =   1620
  114.       Left            =   3330
  115.       MultiSelect     =   2  'Extended
  116.       TabIndex        =   0
  117.       Top             =   360
  118.       Width           =   2535
  119.    End
  120.    Begin VB.Label lblSelected 
  121.       Caption         =   "Selected Items:"
  122.       Height          =   195
  123.       Left            =   3375
  124.       TabIndex        =   3
  125.       Top             =   135
  126.       Width           =   1095
  127.    End
  128.    Begin VB.Label lblAvailable 
  129.       Caption         =   "Available Items:"
  130.       Height          =   195
  131.       Left            =   180
  132.       TabIndex        =   2
  133.       Top             =   135
  134.       Width           =   1140
  135.    End
  136. End
  137. Attribute VB_Name = "axPicker"
  138. Attribute VB_GlobalNameSpace = False
  139. Attribute VB_Creatable = True
  140. Attribute VB_PredeclaredId = False
  141. Attribute VB_Exposed = True
  142. Const m_def_BorderStyle = 2
  143.  
  144. Dim m_BorderStyle As Integer, iLast As Integer
  145.  
  146. Public Enum AxBorderStyles
  147.     [No Border] = 0
  148.     [Single] = 1
  149.     [Thin Raised] = 2
  150.     [Thick Raised] = 3
  151.     [Thin Inset] = 4
  152.     [Thick Inset] = 5
  153.     [Etched] = 6
  154.     [Bump] = 7
  155. End Enum
  156.  
  157. Private Sub axButton_Click(Index As Integer)
  158. iLast = -1
  159. Select Case Index
  160. Case 0
  161.   For i = 0 To lstAvailable.ListCount - 1
  162.     lstSelected.AddItem lstAvailable.List(i)
  163.   Next
  164.   lstAvailable.Clear
  165.  
  166. Case 1
  167.   If lstAvailable.ListIndex = -1 Then Exit Sub
  168.   For i = lstAvailable.ListCount - 1 To 0 Step -1
  169.     If lstAvailable.Selected(i) = True Then
  170.       iLast = i
  171.       lstSelected.AddItem lstAvailable.List(i)
  172.       lstAvailable.RemoveItem i
  173.     End If
  174.   Next
  175.   
  176.   If lstAvailable.ListCount And iLast >= 0 Then
  177.     If lstAvailable.ListCount - 1 < iLast Then
  178.       lstAvailable.Selected(lstAvailable.ListCount - 1) = True
  179.     Else
  180.       lstAvailable.Selected(iLast) = True
  181.     End If
  182.   End If
  183.  
  184. Case 2
  185.   If lstSelected.ListIndex = -1 Then Exit Sub
  186.   For i = lstSelected.ListCount - 1 To 0 Step -1
  187.     If lstSelected.Selected(i) = True Then
  188.       iLast = i
  189.       lstAvailable.AddItem lstSelected.List(i)
  190.       lstSelected.RemoveItem i
  191.     End If
  192.   Next
  193.  
  194.   If lstSelected.ListCount And iLast >= 0 Then
  195.     If lstSelected.ListCount - 1 < iLast Then
  196.       lstSelected.Selected(lstSelected.ListCount - 1) = True
  197.     Else
  198.       lstSelected.Selected(iLast) = True
  199.     End If
  200.   End If
  201.  
  202. Case 3
  203.   For i = 0 To lstSelected.ListCount - 1
  204.     lstAvailable.AddItem lstSelected.List(i)
  205.   Next
  206.   lstSelected.Clear
  207.  
  208. End Select
  209.  
  210. End Sub
  211.  
  212.  
  213. Private Sub lstAvailable_DblClick()
  214.   If lstAvailable.ListIndex = -1 Then Exit Sub
  215.   iLast = lstAvailable.ListIndex
  216.   lstSelected.AddItem lstAvailable.List(lstAvailable.ListIndex)
  217.   lstAvailable.RemoveItem lstAvailable.ListIndex
  218.   
  219.   If lstAvailable.ListCount Then
  220.     If lstAvailable.ListCount - 1 < iLast Then
  221.       lstAvailable.Selected(lstAvailable.ListCount - 1) = True
  222.     Else
  223.       lstAvailable.Selected(iLast) = True
  224.     End If
  225.   End If
  226. End Sub
  227.  
  228.  
  229. Private Sub lstSelected_DblClick()
  230.   If lstSelected.ListIndex = -1 Then Exit Sub
  231.   iLast = lstSelected.ListIndex
  232.   lstAvailable.AddItem lstSelected.List(lstSelected.ListIndex)
  233.   lstSelected.RemoveItem lstSelected.ListIndex
  234.   
  235.   If lstSelected.ListCount Then
  236.     If lstSelected.ListCount - 1 < iLast Then
  237.       lstSelected.Selected(lstSelected.ListCount - 1) = True
  238.     Else
  239.       lstSelected.Selected(iLast) = True
  240.     End If
  241.   End If
  242. End Sub
  243.  
  244. Private Sub UserControl_Initialize()
  245.   UserControl.Height = 2130: UserControl.Width = 6135
  246. End Sub
  247.  
  248. Private Sub UserControl_InitProperties()
  249.     m_BorderStyle = m_def_BorderStyle
  250.  
  251. End Sub
  252.  
  253. Private Sub UserControl_Resize()
  254.   'If lstAvailable.Height + lstAvailable.Top + 10 > 142 Then UserControl.ScaleHeight = lstAvailable.Height + lstAvailable.Top + 10
  255.  
  256.   lstAvailable.Height = UserControl.ScaleHeight - lstAvailable.Top - 10
  257.   lstAvailable.Width = IIf(UserControl.ScaleWidth > 0, Int((UserControl.ScaleWidth - 60) / 2), 0)
  258.   
  259.   lstSelected.Height = UserControl.ScaleHeight - lstAvailable.Top - 10
  260.   lstSelected.Width = IIf(UserControl.ScaleWidth > 0, Int((UserControl.ScaleWidth - 60) / 2), 0)
  261.   lstSelected.Left = lstAvailable.Left + lstAvailable.Width + 40
  262.   lblSelected.Left = lstAvailable.Left + lstAvailable.Width + 42
  263.   
  264.   fraButtons.Left = lstAvailable.Left + lstAvailable.Width + 5
  265.     
  266.   'UserControl.ScaleHeight = lstAvailable.Height + lstAvailable.Top + 10
  267.   If UserControl.Height < 2130 Then
  268.     UserControl.Height = 2130
  269.   Else
  270.     UserControl.Height = (lstAvailable.Height + lstAvailable.Top + 10) * Screen.TwipsPerPixelY
  271.   End If
  272.   
  273.  '   UserControl.ScaleHeight = lstAvailable.Height + lstAvailable.Top + 10
  274.   
  275.   UserControl.Cls
  276.   UserControl_Paint
  277.   
  278.   
  279. End Sub
  280.  
  281. Public Sub AddItemA(Item As String, Optional Index)
  282. Attribute AddItemA.VB_Description = "Add item to available listbox"
  283.   If IsMissing(Index) Then
  284.     lstAvailable.AddItem Item
  285.   Else
  286.     lstAvailable.AddItem Item, Index
  287.   End If
  288. End Sub
  289. Public Sub AddItemS(Item As String, Optional Index)
  290. Attribute AddItemS.VB_Description = "Add item to selected listbox"
  291.   If IsMissing(Index) Then
  292.     lstSelected.AddItem Item
  293.   Else
  294.     lstSelected.AddItem Item, Index
  295.   End If
  296. End Sub
  297.  
  298. Public Sub RemoveItemA(ByVal Index As Integer)
  299. Attribute RemoveItemA.VB_Description = "Remove item from available listbox"
  300.   lstAvailable.RemoveItem Index
  301. End Sub
  302. Public Sub RemoveItemS(ByVal Index As Integer)
  303. Attribute RemoveItemS.VB_Description = "Remove item from selected listbox"
  304.   lstSelected.RemoveItem Index
  305. End Sub
  306. Public Sub ClearA()
  307. Attribute ClearA.VB_Description = "Clear available listbox"
  308.   lstAvailable.Clear
  309. End Sub
  310. Public Sub ClearS()
  311. Attribute ClearS.VB_Description = "Clear selected listbox"
  312.   lstSelected.Clear
  313. End Sub
  314.  
  315. Public Property Get ListIndexA() As Integer
  316. Attribute ListIndexA.VB_Description = "Currently selected item in available listbox"
  317. Attribute ListIndexA.VB_MemberFlags = "400"
  318.     ListIndexA = lstAvailable.ListIndex
  319. End Property
  320. Public Property Get ListCountA() As Integer
  321. Attribute ListCountA.VB_Description = "Count of items in available listbox"
  322. Attribute ListCountA.VB_MemberFlags = "400"
  323.   ListCountA = lstAvailable.ListCount
  324. End Property
  325. Public Property Get ListA(ByVal Index As Integer) As String
  326. Attribute ListA.VB_Description = "String array of items in available listbox"
  327. Attribute ListA.VB_MemberFlags = "400"
  328.   ListA = lstAvailable.List(Index)
  329. End Property
  330.  
  331. Public Property Get ListIndexS() As Integer
  332. Attribute ListIndexS.VB_Description = "Current selected item in selected listbox"
  333. Attribute ListIndexS.VB_MemberFlags = "400"
  334.     ListIndexS = lstSelected.ListIndex
  335. End Property
  336. Public Property Get ListCountS() As Integer
  337. Attribute ListCountS.VB_Description = "Count of items in selected listbox"
  338. Attribute ListCountS.VB_MemberFlags = "400"
  339.   ListCountS = lstSelected.ListCount
  340. End Property
  341. Public Property Get ListS(ByVal Index As Integer) As String
  342. Attribute ListS.VB_Description = "String array of items in selected listbox"
  343. Attribute ListS.VB_MemberFlags = "400"
  344.   ListS = lstSelected.List(Index)
  345. End Property
  346.  
  347. Public Sub ShowAbout()
  348. Attribute ShowAbout.VB_Description = "Show about box for control"
  349. Attribute ShowAbout.VB_UserMemId = -552
  350.   frmAbout.Show vbModal
  351. End Sub
  352. 'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
  353. 'MappingInfo=UserControl,UserControl,-1,Enabled
  354. Public Property Get Enabled() As Boolean
  355. Attribute Enabled.VB_Description = "Returns/sets a value that determines whether an object can respond to user-generated events."
  356.     Enabled = UserControl.Enabled
  357. End Property
  358.  
  359. Public Property Let Enabled(ByVal New_Enabled As Boolean)
  360.     UserControl.Enabled() = New_Enabled
  361.     PropertyChanged "Enabled"
  362. End Property
  363.  
  364. 'Public Property Get MultiSelect() As Boolean
  365. '    MultiSelect = m_MultiSelect
  366. 'End Property
  367.  
  368. 'Public Property Let MultiSelect(ByVal New_MultiSelect As Boolean)
  369. '    lstAvailable.MultiSelect = IIf(New_MultiSelect, 2, 0)
  370. '    lstSelected.MultiSelect = IIf(New_MultiSelect, 2, 0)
  371. '    m_MultiSelect = New_MultiSelect
  372. '    PropertyChanged "MultiSelect"
  373. 'End Property
  374.  
  375. 'Load property values from storage
  376. Private Sub UserControl_ReadProperties(PropBag As PropertyBag)
  377.  
  378.     UserControl.Enabled = PropBag.ReadProperty("Enabled", True)
  379.     m_BorderStyle = PropBag.ReadProperty("BorderStyle", m_def_BorderStyle)
  380.     m_MultiSelect = PropBag.ReadProperty("MultiSelect", False)
  381. End Sub
  382.  
  383. 'Write property values to storage
  384. Private Sub UserControl_WriteProperties(PropBag As PropertyBag)
  385.  
  386.     Call PropBag.WriteProperty("Enabled", UserControl.Enabled, True)
  387.     Call PropBag.WriteProperty("BorderStyle", m_BorderStyle, m_def_BorderStyle)
  388.     Call PropBag.WriteProperty("MultiSelect", m_MultiSelect, False)
  389. End Sub
  390.  
  391. Public Property Get BorderStyle() As AxBorderStyles
  392. Attribute BorderStyle.VB_Description = "Set border style for control"
  393.     BorderStyle = m_BorderStyle
  394. End Property
  395.  
  396. Public Property Let BorderStyle(ByVal New_BorderStyle As AxBorderStyles)
  397.     If Not (m_BorderStyle = New_BorderStyle) Then
  398.         m_BorderStyle = New_BorderStyle
  399.         UserControl.Cls
  400.         UserControl_Paint
  401.     End If
  402.     PropertyChanged "BorderStyle"
  403. End Property
  404.  
  405. Private Sub UserControl_Paint()
  406.     Dim di As Long
  407.     Dim rc As RECT
  408.     
  409.     'draw outside border
  410.         
  411.     Select Case m_BorderStyle
  412.         Case [No Border]
  413.         
  414.         Case [Single]
  415.             di = GetClientRect(UserControl.hWnd, rc)
  416.             di = DrawEdge(UserControl.hDC, rc, BDR_RAISEDOUTER, BF_RECT Or BF_MONO)
  417.         
  418.         Case [Thin Raised]
  419.             di = GetClientRect(UserControl.hWnd, rc)
  420.             di = DrawEdge(UserControl.hDC, rc, BDR_RAISEDINNER, BF_TOPLEFT)
  421.             di = DrawEdge(UserControl.hDC, rc, BDR_RAISEDOUTER, BF_BOTTOMRIGHT)
  422.         
  423.         Case [Thick Raised]
  424.             di = GetClientRect(UserControl.hWnd, rc)
  425.             di = DrawEdge(UserControl.hDC, rc, EDGE_RAISED, BF_TOPLEFT)
  426.             di = DrawEdge(UserControl.hDC, rc, EDGE_RAISED, BF_BOTTOMRIGHT)
  427.     
  428.         Case [Thin Inset]
  429.             di = GetClientRect(UserControl.hWnd, rc)
  430.             di = DrawEdge(UserControl.hDC, rc, BDR_SUNKENINNER, BF_TOPLEFT)
  431.             di = DrawEdge(UserControl.hDC, rc, BDR_SUNKENOUTER, BF_BOTTOMRIGHT)
  432.         
  433.         Case [Thick Inset]
  434.             di = GetClientRect(UserControl.hWnd, rc)
  435.             di = DrawEdge(UserControl.hDC, rc, EDGE_SUNKEN, BF_TOPLEFT)
  436.             di = DrawEdge(UserControl.hDC, rc, EDGE_SUNKEN, BF_BOTTOMRIGHT)
  437.         
  438.         Case [Etched]
  439.             di = GetClientRect(UserControl.hWnd, rc)
  440.             di = DrawEdge(UserControl.hDC, rc, EDGE_ETCHED, BF_TOPLEFT)
  441.             di = DrawEdge(UserControl.hDC, rc, EDGE_ETCHED, BF_BOTTOMRIGHT)
  442.     
  443.         Case [Bump]
  444.             di = GetClientRect(UserControl.hWnd, rc)
  445.             di = DrawEdge(UserControl.hDC, rc, EDGE_BUMP, BF_TOPLEFT)
  446.             di = DrawEdge(UserControl.hDC, rc, EDGE_BUMP, BF_BOTTOMRIGHT)
  447.             
  448.     End Select
  449.         
  450. End Sub
  451.  
  452. 'MappingInfo=UserControl,UserControl,-1,Ambient
  453. Public Property Get Ambient() As AmbientProperties
  454.   Set Ambient = UserControl.Ambient
  455. End Property
  456.  
  457.  
  458.  
  459.